perm filename GEOMEL.FAI[GEM,HE]3 blob sn#141937 filedate 1975-02-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE GEOMEL
C00004 00003	
C00005 00004	STORE A LEFT HALF WORD FROM LISP INTO A GEOMED NODE.
C00007 ENDMK
C⊗;
TITLE GEOMEL
	OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]↔OPDEF GO[JRST]
	I ←← 577777
RESULT↑:0
$MORCOR↑:HALT

;LISP LINK FETCH ROUTINES....
	NFACE↑:	CAR 1,1-I(1)↔ADDI 1,I↔POPJ 14,		;RINGS OF F.E.V.
	PFACE↑:	CDR 1,1-I(1)↔ADDI 1,I↔POPJ 14,
	NED↑:	CAR 1,2-I(1)↔ADDI 1,I↔POPJ 14,
	PED↑:	CDR 1,2-I(1)↔ADDI 1,I↔POPJ 14,
	NVT↑:	CAR 1,3-I(1)↔ADDI 1,I↔POPJ 14,
	PVT↑:	CDR 1,3-I(1)↔ADDI 1,I↔POPJ 14,

NCW↑:	DAD↑:	CAR 1,4-I(1)↔ADDI 1,I↔POPJ 14,		;WINGS & PARTS TREE.
PCW↑:	SON↑:	CDR 1,4-I(1)↔ADDI 1,I↔POPJ 14,
NCCW↑:	BRO↑:	CAR 1,5-I(1)↔ADDI 1,I↔POPJ 14,
PCCW↑:	SIS↑:	CDR 1,5-I(1)↔ADDI 1,I↔POPJ 14,

	ALT↑:	CAR 1,6-I(1)↔ADDI 1,I↔POPJ 14,
ALT2↑:	TRAM↑:	CDR 1,6-I(1)↔ADDI 1,I↔POPJ 14,
	CW↑:	CAR 1,7-I(1)↔ADDI 1,I↔POPJ 14,
	CCW↑:	CDR 1,7-I(1)↔ADDI 1,I↔POPJ 14,

	NLINK↑:	CAR 1,8-I(1)↔ADDI 1,I↔POPJ 14,		;USER LINK POSITIONS.
	PLINK↑:	CDR 1,8-I(1)↔ADDI 1,I↔POPJ 14,

AA↑:	XWC↑:	SKIPA 1,-3-I(1)
BB↑:	YWC↑:	MOVE  1,-2-I(1)↔GO @$FLONUM↑
CC↑:	ZWC↑:	SKIPA 1,-1-I(1)

IX↑:		MOVE  1, 0-I(1)↔GO @$FLONUM↑
JX↑:		SKIPA 1, 1-I(1)
KX↑:		MOVE  1, 2-I(1)↔GO @$FLONUM↑

IY↑:		SKIPA 1, 3-I(1)
JY↑:	XPP↑:	MOVE  1, 4-I(1)↔GO @$FLONUM↑
KY↑:	YPP↑:	SKIPA 1, 5-I(1)

IZ↑:	ZPP↑:	MOVE  1, 6-I(1)↔GO @$FLONUM↑
JZ↑:		SKIPA 1, 7-I(1)
KZ↑:		MOVE  1, 8-I(1)↔GO @$FLONUM↑



INTERN AA$,BB$,CC$,XWC$,YWC$,ZWC$,ZWC$,XPP$,YPP$,ZPP$
INTERN IX$,IY$,IZ$,JX$,JY$,JZ$,KX$,KY$,KZ$

	AA$: XWC$:	SUBI 2,3↔GO IX$
	BB$: YWC$:	SUBI 2,2↔GO IX$
	CC$: ZWC$:	SOJA 2,IX$
	IY$:		AOJA 2,IX$
	IZ$:		ADDI 2,2↔GO IX$
	JX$:		ADDI 2,3↔GO IX$
	JY$: XPP$:	ADDI 2,4↔GO IX$
	JZ$: YPP$:	ADDI 2,5↔GO IX$
	KX$: ZPP$:	ADDI 2,6↔GO IX$
	KY$:		ADDI 2,7↔GO IX$
	KZ$:		ADDI 2,8↔GO IX$

;STORE A FULL WORD FROM LISP INTO A GEOMED NODE.
IX$:	MOVE 3,1↔TRNE 3,400000↔GO .+4	;TEST FOR INUM.
	CDR 3,(3)↔CDR 3,(3)↔SKIPA 3,(3) ;LISP FULL WORD NUMBER.
	SUBI 3,I			;INUM INTO MACHINE INTEGER.
	MOVEM 3,-I(2)↔POPJ 14,		;STORE.


;STORE A LEFT HALF WORD FROM LISP INTO A GEOMED NODE.
	NFACE$↑:AOJA 2,NSTORE
	NED$↑:	ADDI 2,2↔GO NSTORE
	NVT$↑:	ADDI 2,3↔GO NSTORE
NCW$↑:	DAD$↑:	ADDI 2,4↔GO NSTORE
NCCW$↑:	BRO$↑:	ADDI 2,5↔GO NSTORE
	ALT$↑:	ADDI 2,6↔GO NSTORE
	CW$↑:	ADDI 2,7↔GO NSTORE
	NLINK$↑:ADDI 2,8
NSTORE: MOVE 3,1↔TRNE 3,400000↔GO .+4	;TEST FOR INUM.
	CDR 3,(3)↔CDR 3,(3)↔SKIPA 3,(3)	;LISP FULL WORD NUMBER.
	SUBI 3,I			;INUM INTO MACHINE INTEGER.
	HRLM 3,-I(2)↔POPJ 14,		;STORE.

;STORE A RIGHT HALF WORD FROM LISP INTO A GEOMED NODE.
	PFACE$↑:AOJA 2,PSTORE
	PED$↑: 	ADDI 2,2↔GO PSTORE
	PVT$↑:	ADDI 2,3↔GO PSTORE
PCW$↑:	SON$↑:	ADDI 2,4↔GO PSTORE
PCCW$↑:	SIS$↑:	ADDI 2,5↔GO PSTORE
ALT2$↑:	TRAM$↑:	ADDI 2,6↔GO PSTORE
	CCW$↑:	ADDI 2,7↔GO PSTORE
	PLINK$↑:ADDI 2,8
PSTORE: MOVE 3,1↔TRNE 3,400000↔GO .+4	;TEST FOR INUM.
	CDR 3,(3)↔CDR 3,(3)↔SKIPA 3,(3)	;LISP FULL WORD NUMBER.
	SUBI 3,I			;INUM INTO MACHINE INTEGER.
	HRRM 3,-I(2)↔POPJ 14,		;STORE.
END